home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / programm.ing / m2posx10.zoo / m2posix.10 / src / posix2.ipp < prev    next >
Encoding:
Modula Implementation  |  1993-08-18  |  10.4 KB  |  306 lines
  1. IMPLEMENTATION MODULE POSIX2;
  2. __IMP_SWITCHES__
  3. #ifdef HM2
  4. #ifdef __LONG_WHOLE__
  5. (*$!i+: Modul muss mit $i- uebersetzt werden! *)
  6. (*$!w+: Modul muss mit $w- uebersetzt werden! *)
  7. #else
  8. (*$!i-: Modul muss mit $i+ uebersetzt werden! *)
  9. (*$!w-: Modul muss mit $w+ uebersetzt werden! *)
  10. #endif
  11. #endif
  12. (*****************************************************************************)
  13. (* "fnmatch()":                                                              *)
  14. (* Als Grundlage dienten die 'C'-Dateien 'glob.c' der GNU-Shell BASH und     *)
  15. (* 'fnmatch.c/h' der GNU-Fileutils.                                          *)
  16. (*---------------------------------------------------------------------------*)
  17. (* 13-Aug-93, Holger Kleinschmidt                                            *)
  18. (*****************************************************************************)
  19.  
  20. VAL_INTRINSIC
  21.  
  22. FROM PORTAB IMPORT
  23. (* TYPE *) UNSIGNEDWORD;
  24.  
  25. FROM pSTRING IMPORT
  26. (* PROC *) SLEN;
  27.  
  28. FROM types IMPORT
  29. (* CONST*) EOS, XDIRSEP;
  30.  
  31. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  32.  
  33. PROCEDURE fnmatch ((* EIN/ -- *) REF str   : ARRAY OF CHAR;
  34.                    (* EIN/ -- *) REF pat   : ARRAY OF CHAR;
  35.                    (* EIN/ -- *)     flags : FNMFlags      ): INTEGER;
  36. (*T*)
  37. VAR sLen, pLen : UNSIGNEDWORD;
  38.     dot        : BOOLEAN;
  39.     escape     : BOOLEAN;
  40.     pathname   : BOOLEAN;
  41.  
  42. PROCEDURE match (SIDX : UNSIGNEDWORD;
  43.                  PIDX : UNSIGNEDWORD ): BOOLEAN;
  44. (*T*)
  45. VAR         inverted : BOOLEAN;
  46.             cmin     : CHAR;
  47.             cmax     : CHAR;
  48.     __REG__ cs       : CHAR;
  49.     __REG__ sidx     : UNSIGNEDWORD;
  50.     __REG__ pidx     : UNSIGNEDWORD;
  51.     __REG__ pend     : UNSIGNEDWORD;
  52.  
  53. BEGIN (* match *)
  54.  sidx := SIDX;
  55.  pidx := PIDX;
  56.  
  57.  WHILE pidx < pLen DO
  58.  
  59.    IF sidx < sLen THEN
  60.      cs := str[sidx];
  61.    ELSE
  62.      cs := EOS;
  63.    END;
  64.  
  65.    CASE pat[pidx] OF
  66.      '[': IF    (cs = EOS)
  67.              OR pathname AND (cs = XDIRSEP)
  68.              OR dot      AND (cs = '.')
  69.                          AND (   (sidx = 0)
  70.                               OR pathname AND (str[sidx-1] = XDIRSEP))
  71.           THEN
  72.             (* Wenn der String kein Zeichen mehr enthaelt, oder ein
  73.              * Pfadtrenner nicht ``gematched'' werden darf, oder ein Dateiname
  74.              * mit fuehrendem Punkt nicht ``gematched'' werden darf (entweder
  75.              * am Stringanfang oder direkt nach einem Pfadtrenner), schlaegt
  76.              * der Vergleich fehl.
  77.              *)
  78.             RETURN(FALSE);
  79.           END;
  80.  
  81.           INC(pidx);
  82.           IF (pidx < pLen) AND (pat[pidx] = INVERTCHAR) THEN
  83.             inverted := TRUE;
  84.             INC(pidx);
  85.           ELSE
  86.             inverted := FALSE;
  87.           END;
  88.           pend := pidx;
  89.  
  90.           (* Ein ']' an erster Stelle, evtl. hinter einem '!', beendet nicht
  91.            * die Menge, sondern steht fuer das zu ``matchende'' Zeichen,
  92.            * hat also keine Spezialbedeutung. Deswegen wird das erste
  93.            * Zeichen der Menge uebersprungen.
  94.            * Wenn das Escapezeichen erlaubt ist, bedeutet "...\]..."
  95.            * nicht das Ende der Menge, sondern steht fuer ein zu
  96.            * ``matchendes'' ']'.
  97.            *)
  98.           REPEAT
  99.             INC(pend);
  100.           UNTIL (pend >= pLen) OR     (pat[pend] = ']')
  101.                                   AND (   NOT escape
  102.                                        OR (pat[pend-1] <> ESCAPECHAR));
  103.  
  104.           IF pend >= pLen THEN
  105.             (* Syntaxfehler: Menge nicht korrekt abgeschlossen *)
  106.             RETURN(FALSE);
  107.           END;
  108.  
  109.           (* Durch das Testen auf korrekten Abschluss mit ']' koennen
  110.            * in der nachfolgenden Schleife einige Tests auf zu grosses
  111.            * 'pidx' entfallen.
  112.            *)
  113.           LOOP
  114.             IF escape AND (pat[pidx] = ESCAPECHAR) THEN
  115.               INC(pidx);
  116.             END;
  117.  
  118.             cmin := pat[pidx];
  119.             cmax := cmin;
  120.             INC(pidx);
  121.  
  122.             IF (pat[pidx] = '-') AND (pidx + 1 < pend) THEN
  123.               (* Ein Bereich ist nur vorhanden, falls die Obergrenze
  124.                * nicht ']' ist; in diesem Fall steht '-' fuer ein
  125.                * Einzelzeichen, und die Klammer beendet die Menge.
  126.                *)
  127.               INC(pidx);
  128.               IF escape AND (pat[pidx] = ESCAPECHAR) THEN
  129.                 INC(pidx);
  130.               END;
  131.               cmax := pat[pidx];
  132.               INC(pidx);
  133.             END;
  134.  
  135.             IF (cmin <= cs) AND (cs <= cmax) THEN
  136.               (* --> MATCH *)
  137.               IF inverted THEN
  138.                 RETURN(FALSE);
  139.               ELSE
  140.                 pidx := pend;
  141.                 EXIT;
  142.               END;
  143.             ELSIF pidx = pend THEN
  144.               (* --> NO MATCH *)
  145.               IF inverted THEN
  146.                 EXIT;
  147.               ELSE
  148.                 RETURN(FALSE);
  149.               END;
  150.             END; (* IF cmin <= cs ... *)
  151.           END; (* LOOP *)
  152.           INC(sidx);
  153.           INC(pidx);
  154.  
  155.     |'*': REPEAT
  156.             INC(pidx);
  157.           UNTIL (pidx = pLen) OR (pat[pidx] <> '*');
  158.           DEC(pidx);
  159.  
  160.           (* Mehrere '*' hintereinander sind aequivalent zu einem einzelnen.
  161.            * Bis zum letzten '*' ueberlesen.
  162.            *)
  163.  
  164.           IF pathname AND (cs = XDIRSEP) THEN
  165.             (* Wenn '*' auf einen Pfadtrenner trifft, ``matched'' es nur
  166.              * die leere Zeichenkette, d.h. der Rest des Musters muss
  167.              * ohne '*' auf den augenblicklichen String passen.
  168.              *)
  169.             INC(pidx);
  170.           ELSIF dot AND (cs = '.')
  171.                     AND (   (sidx = 0)
  172.                          OR pathname AND (str[sidx-1] = XDIRSEP))
  173.           THEN
  174.             RETURN(FALSE);
  175.           ELSE
  176.  
  177.             (* Das Muster hinter dem '*' wird mit jedem moeglichen Reststring
  178.              * verglichen. Das muss rekursiv geschehen, da das Restmuster
  179.              * wiederum '*' enthalten kann (und auch jedesmal wieder auf
  180.              * '.' und '/' geachtet werden muss).
  181.              * Es werden soviele Rekursionsebenen aufgebaut, wie der Reststring
  182.              * noch lang ist. Beim rekursiven Aufstieg wird dann der Vergleich
  183.              * durchgefuehrt, wobei in jeder Ebene der Reststring mit dem Muster
  184.              * hinter dem '*' verglichen wird.
  185.              *
  186.              * Der ``schlimmste'' Fall, also der mit den meisten rekursiven
  187.              * Aufrufen, ist ein Muster folgender Art:
  188.              *
  189.              *   pat = "*?*?*?*?*?..."
  190.              *
  191.              * und ein String mit mindestens soviel Zeichen, wie das Muster
  192.              * '*' hat.
  193.              * Die Zahl an Rekursionsaufrufen berechnet sich in diesem Fall aus:
  194.              *
  195.              *   rcalls = 2^stars - 1 + (sLen - stars)
  196.              *
  197.              * wobei 'stars' die Anzahl der '*' im Muster ist und sich aus
  198.              *
  199.              *   stars = pLen DIV 2
  200.              *
  201.              * ergibt.
  202.              * Der Aufwand ist also exponentiell, falls mehrere '*' im Muster
  203.              * vorkommen!
  204.              *
  205.              * Die ``schlimmste'' Rekursionstiefe ist dagegen nicht ganz so
  206.              * wild, sie entspricht der Stringlaenge:
  207.              *
  208.              *   rdepth = sLen
  209.              *
  210.              * Beispiel: str = "xxxx" (sLen =4), pat = "*?*?*?*?" (stars=4)
  211.              *
  212.              * Graph der Aufrufe; die Waagerechte kennzeichnet die Rekursions-
  213.              * ebene, die Zahlen bedeuten die Anzahl der Aufrufe auf der
  214.              * jeweiligen Ebene (haengen von der jeweiligen Laenge des Rest-
  215.              * strings ab):
  216.              *
  217.              *         Ebene 0:  Aufruf durch 'fnmatch()'
  218.              *                        |
  219.              *                        V
  220.              *         Ebene 1:  -----4--------
  221.              *                      / | \
  222.              *                     /  |  \
  223.              *                   -1---2---3----
  224.              *            .           /  / \
  225.              *            .          /  /   \
  226.              *            .      ---1--1-----2-
  227.              *                              /
  228.              *                             /
  229.              *         Ebene 4:  ---------1----
  230.              *
  231.              * insgesamt 15 rekursive Aufrufe.
  232.              *
  233.              * Die Strings, dargestellt zum Zeitpunkt des rekursiven Aufrufs:
  234.              *
  235.              *   pat  = "*?*?*?"  "*?*?"       "*?*?"   "*?*?"
  236.              *
  237.              *   str  =   "123"  .............  "23"  ..  "3"
  238.              *              |                    |         |
  239.              *             "23"  .. "3"         "3"        ""
  240.              *              |        |           |
  241.              *             "3"       ""          ""
  242.              *              |
  243.              *              ""
  244.              *
  245.              * Falls der String laenger ist, wird die Rekursionsebene erst
  246.              * solange linear erhoeht, bis der Reststring genauso lang wie die
  247.              * Anzahl der '*', dann spannt sich der Baum genauso auf.
  248.              *)
  249.             IF (cs <> EOS) AND match(sidx+1, pidx) THEN
  250.               RETURN(TRUE);
  251.             END;
  252.             INC(pidx);
  253.           END;
  254.  
  255.     |'?': IF    (cs = EOS)
  256.              OR pathname AND (cs = XDIRSEP)
  257.              OR dot      AND (cs = '.')
  258.                          AND (   (sidx = 0)
  259.                               OR pathname AND (str[sidx-1] = XDIRSEP))
  260.           THEN
  261.             RETURN(FALSE);
  262.           END;
  263.           INC(sidx);
  264.           INC(pidx);
  265.  
  266.     |ESCAPECHAR:
  267.           IF escape THEN
  268.             INC(pidx);
  269.           END;
  270.           IF pidx = pLen THEN
  271.             RETURN(cs = EOS);
  272.           ELSIF pat[pidx] <> cs THEN
  273.             RETURN(FALSE);
  274.           END;
  275.           INC(sidx);
  276.           INC(pidx);
  277.  
  278.      ELSE
  279.           IF pat[pidx] <> cs THEN
  280.             RETURN(FALSE);
  281.           END;
  282.           INC(sidx);
  283.           INC(pidx);
  284.    END; (* CASE *)
  285.  END; (* WHILE *)
  286.  
  287.  (* Wenn das Muster beendet ist, muss auch der String zuende sein.*)
  288.  RETURN(sidx = sLen);
  289. END match;
  290.  
  291. BEGIN (* fnmatch *)
  292.  escape   := NOT (FNMNoEscape IN flags);
  293.  pathname := FNMPathname IN flags;
  294.  dot      := FNMPeriod IN flags;
  295.  sLen     := VAL(UNSIGNEDWORD,SLEN(str));
  296.  pLen     := VAL(UNSIGNEDWORD,SLEN(pat));
  297.  
  298.  IF match(0, 0) THEN
  299.    RETURN(0);
  300.  ELSE
  301.    RETURN(FNMNoMatch);
  302.  END;
  303. END fnmatch;
  304.  
  305. END POSIX2.
  306.